home *** CD-ROM | disk | FTP | other *** search
- PROGRAM KeyEdDemo;
- { copyright F.Samuel and MacTutor 1988 }
- { use only with system 4.x or later }
- {$I-}
- { turn off automatic initialization }
- {$L keyEdDemoRes}
- { load resource file }
-
- CONST
- DialogID = 128;
- EditCodeItem = 2;
- LoadBtn = 5;
- UserItem = 6;
- AsciiCharItem = 7;
- KeyCodeItem = 8;
- AboutAlrt = 129;
- LoadAlrt = 130;
- AppleID = 1;
- AboutItem = 1;
- FileID = 2;
- EditID = 3;
- CutItem = 3;
- CopyItem = 4;
- PasteItem = 5;
- ClearItem = 6;
-
- { Low-memory globals }
- KybdType = $21E;
- ScsiFlag = $B22;
- Key1Trans = $29E;
- BasicGlob = $2B6;
-
- { KCaps ID of various keyboards }
- MacPlusKbd = 11;
- MacClassicKbd = 3;
- EuroMacKbd = 259;
- ADBKbd = 1;
- ADBExtKbd = 2;
- ADBIsoKbd = 4;
-
- TYPE
- Prect = ^Rect; { for type-casting a pointer }
- PLong = ^LongInt;
- PWord = ^integer;
- PPoint = ^Point;
-
- VAR
- Finished, EditOn : Boolean;
- DragRect : Rect;
- MouseLocal : Point;
- KCapsHandle, KChrHandle : Handle;
- DemoDialog : DialogPtr;
- HiliteKeys : SET OF 0..127;
- EditKey, EditModifs : Integer;
-
- { utilities to acces properties of items in a dialog }
-
- PROCEDURE SetDItemText (TheDialog : DialogPtr;
- TheItem : Integer;
- TheText : Str255);
- VAR
- ItemType : integer; { should be a text item }
- ItemHandle : Handle;
- DispRect : Rect;
- BEGIN
- GetDItem(TheDialog, TheItem, ItemType, ItemHandle, DispRect);
- SetIText(ItemHandle, TheText)
- END;
-
- FUNCTION GetDItemText (TheDialog : DialogPtr;
- TheItem : Integer) : Str255;
- VAR
- ItemType : integer; { should be a text item }
- ItemHandle : Handle;
- DispRect : Rect;
- TheText : Str255;
- BEGIN
- GetDItem(TheDialog, TheItem, ItemType, ItemHandle, DispRect);
- GetIText(ItemHandle, TheText);
- GetDItemText := TheText
- END;
-
- FUNCTION GetDItemRect (TheDialog : DialogPtr;
- TheItem : Integer) : Rect;
- VAR
- ItemType : integer;
- ItemHandle : Handle;
- DispRect : Rect;
- BEGIN
- GetDItem(TheDialog, TheItem, ItemType, ItemHandle, DispRect);
- GetDItemRect := DispRect
- END;
-
- PROCEDURE SetUserProc (TheDialog : DialogPtr;
- TheItem : Integer;
- TheProc : procPtr);
- VAR
- ItemType : integer; { should be an UserItem ! }
- ItemHandle : Handle;
- DispRect : Rect;
- BEGIN
- GetDItem(TheDialog, TheItem, ItemType, ItemHandle, DispRect);
- SetDItem(TheDialog, TheItem, ItemType, Handle(theProc), DispRect)
- END;
-
- { function NumToString , more convenient that way ... }
-
- FUNCTION FNumToString (TheNum : LongInt) : Str255;
- VAR
- TheString : Str255;
- BEGIN
- NumToString(TheNum, TheString);
- FNumToString := TheString
- END;
-
- { interface for external procedures and functions : }
-
- FUNCTION KeyTrans (transData : Ptr;
- keycode : INTEGER;
- VAR state : LONGINT) : LONGINT;
- INLINE
- $A9C3;
-
- PROCEDURE poke (address : longint;
- value : integer);
- external; { puts low byte of value at address }
-
- FUNCTION peek (address : longint) : integer;
- external; { returns byte at address }
-
- FUNCTION Key12Trans (KeyCode, KeyModifs : Integer) : Integer;
- external;
-
- { Pascal procedures and functions follow ... }
-
- FUNCTION GetAscii (KeyCode, Modifs : integer;
- VAR Ascii : integer) : Boolean;
- { Returns true if it's a normal key , Ascii returns ascii code even if it's a double strike}
- VAR
- State : LongInt;
- BEGIN
- State := 0;
- Ascii := LoWord(KeyTrans(KChrHandle^, KeyCode + Modifs, State));
- IF Ascii = 0 THEN
- BEGIN
- GetAscii := false;
- Ascii := LoWord(KeyTrans(KChrHandle^, KeyCode + Modifs, State))
- END
- ELSE
- GetAscii := true
- END;
-
- FUNCTION GetKbd : Integer;
- { returns KCAP ID of current keyboard }
- VAR
- TempID : integer;
- addr : Plong;
- SCSIMac : boolean;
- BEGIN
- TempId := peek(KybdType);
- SCSIMac := BitTst(Ptr(SCSIFlag), 5);
- IF (NOT SCSIMac) AND (TempID <> MacPlusKbd) THEN
- BEGIN
- tempId := MacClassicKbd;
- addr := Plong(Key1Trans);
- IF peek(addr^ + 10) <> 0 THEN { test itlc byte }
- TempId := EuroMacKbd
- END;
- GetKbd := TempID
- END;
-
- PROCEDURE SetUpMenus;
- VAR
- ID : integer;
- BEGIN
- FOR ID := AppleID TO EditID DO
- InsertMenu(GetMenu(ID), 0);
- AddResMenu(GetMHandle(AppleID), 'DRVR');
- DrawMenuBar
- END;
-
- PROCEDURE MainCaps (PROCEDURE treatIt (rgn : RgnHandle;
- Code : integer));
- VAR
- Hrgn : RgnHandle;
- addr : PWord;
- Paddr : PPoint;
- NumRgn, NumRect, NumKeys, i, j : integer;
- Keycode, dh, dv : Integer;
- TL, BR : point;
- KRect : rect;
- BEGIN
- BEGIN
- SetPort(DemoDialog);
- GetMouse(MouseLocal);
- ClipRect(DemoDialog^.PortRect);
- Hlock(KcapsHandle);
- Addr := Pword(Ord4(KcapsHandle^) + 16);
- NumRgn := Addr^;
- IF NumRgn > 0 THEN
- FOR i := 1 TO NumRgn DO
- BEGIN
- Addr := Pword(Ord4(Addr) + 2);
- NumRect := addr^;
- Hrgn := NewRgn;
- OpenRgn;
- SetPt(TL, 0, 0);
- Addr := Pword(Ord4(Addr) + 2);
- FOR j := 0 TO NumRect DO
- BEGIN
- PAddr := PPoint(addr);
- BR := Paddr^;
- Pt2Rect(TL, BR, Krect);
- FrameRect(Krect);
- TL := BR;
- Addr := Pword(Ord4(Addr) + 4);
- END;
- CloseRgn(Hrgn);
- NumKeys := addr^;
- FOR j := 0 TO NumKeys DO
- BEGIN
- Addr := Pword(Ord4(Addr) + 2);
- KeyCode := addr^;
- Addr := Pword(Ord4(Addr) + 2);
- dv := addr^;
- Addr := Pword(Ord4(Addr) + 2);
- dh := addr^;
- OffsetRgn(Hrgn, dh, dv);
- TreatIt(Hrgn, Keycode MOD 128);
- END;
- DisposeRgn(Hrgn);
- END;
- Hunlock(KcapsHandle)
- END
- END;
-
- PROCEDURE InvertKey (Rgn : RgnHandle);
- VAR
- InnerRgn : RgnHandle;
- BEGIN
- InnerRgn := NewRgn;
- CopyRgn(Rgn, InnerRgn);
- InsetRgn(InnerRgn, 2, 2);
- InvertRgn(InnerRgn);
- DisposeRgn(InnerRgn)
- END;
-
- PROCEDURE DrawKey (rgn : RgnHandle;
- Code : integer);
- VAR
- DrawRgn : RgnHandle;
- AsciiCode : Integer;
- NormalKey : boolean;
- BEGIN
- FrameRgn(Rgn);
- DrawRgn := NewRgn;
- CopyRgn(Rgn, DrawRgn);
- InsetRgn(DrawRgn, 1, 1);
- SetClip(DrawRgn);
- EraseRgn(DrawRgn);
- NormalKey := GetAscii(Code, EditModifs, AsciiCode);
- WITH DrawRgn^^.rgnBBox DO
- MoveTo(left + 1, bottom - 2);
- DrawChar(Chr(AsciiCode));
- DisposeRgn(DrawRgn);
- IF Code IN HiliteKeys THEN
- InvertKey(Rgn);
- ClipRect(DemoDialog^.PortRect)
- END;
-
- PROCEDURE UserDraw (TheWindow : WindowPtr;
- ItemNum : Integer);
- VAR
- FillPat : Pattern;
- TheRect : Rect;
- BEGIN
- TheRect := GetDItemRect(DemoDialog, ItemNum);
- GetIndPattern(FillPat, 0, 10);
- FillRect(TheRect, FillPat);
- FrameRect(TheRect);
- MainCaps(DrawKey)
- END;
-
- PROCEDURE InitThings;
- VAR
- i, Error : Integer;
- BEGIN { Get KybdID and KCaps ; SetUserProc;Show dialog }
- FlushEvents(EveryEvent, 0);
- InitGraf(@ThePort);
- InitFonts;
- InitWindows;
- InitMenus;
- TEInit;
- InitDialogs(NIL);
- InitCursor;
- SetEventMask(EveryEvent - KeyUpMask);
- MaxApplZone;
- FOR i := 1 TO 5 DO
- MoreMasters;
- WITH ScreenBits.Bounds DO
- SetRect(DragRect, left + 4, top + 24, right - 4, bottom - 4);
- SetUpMenus;
- KCapsHandle := GetResource('KCAP', GetKbd);
- DetachResource(KCapsHandle); { don't let a DA release it on your back ! }
- KChrHandle := GetResource('KCHR', 0);
- Error := HandToHand(KChrHandle); { make a copy , so we can modify it }
- MoveHHi(KChrHandle); { keep heap unfragmented }
- HLock(KChrHandle);
- HiliteKeys := []; { no keys to hilite until the user selects one }
- EditModifs := 0;
- EditOn := False; { wait for the user to select a key to edit }
- DemoDialog := GetNewDialog(DialogID, NIL, WindowPtr(-1));
- SetUserProc(DemoDialog, UserItem, @UserDraw);
- ShowWindow(DemoDialog);
- Finished := False
- END;
-
- PROCEDURE DoMenu (Code : longint);
- VAR
- MenuNum, ItemNum, Temp : integer;
- DeskAccName : str255;
- BEGIN
- IF code <> 0 THEN
- BEGIN
- MenuNum := HiWord(Code);
- ItemNum := LoWord(Code);
- CASE MenuNum OF
- AppleID :
- IF ItemNum = AboutItem THEN
- Temp := Alert(AboutAlrt, NIL)
- ELSE
- BEGIN
- GetItem(GetMHandle(AppleID), ItemNum, DeskAccName);
- Temp := OpenDeskAcc(DeskAccName);
- END;
- FileID :
- Finished := True;
- EditID :
- IF NOT SystemEdit(ItemNum - 1) THEN
- IF (FrontWindow = DemoDialog) AND EditOn THEN
- CASE ItemNum OF
- CutItem :
- DlgCut(DemoDialog);
- CopyItem :
- DlgCopy(DemoDialog);
- PasteItem :
- DlgPaste(DemoDialog);
- ClearItem :
- DlgDelete(DemoDialog);
- OTHERWISE
- END;
- OTHERWISE
- END;
- HiliteMenu(0)
- END
- END;
-
- PROCEDURE StartEdit (KeyCode, AsciiCode : Integer);
- { enable editing the ascii code of the selected key }
- BEGIN
- EditKey := KeyCode;
- HiliteKeys := HiliteKeys + [EditKey];
- SetDItemText(DemoDialog, EditCodeItem, FNumToString(AsciiCode));
- SelIText(DemoDialog, EditCodeItem, 0, MaxInt);
- SetDItemText(DemoDialog, KeyCodeItem, FNumToString(EditKey));
- SetDItemText(DemoDialog, AsciiCharItem, Chr(AsciiCode));
- EditOn := true
- END;
-
- PROCEDURE DrawEditKRgn (Rgn : RgnHandle;
- TheCode : Integer);
- { update key contents in case it changed }
- BEGIN
- IF TheCode = EditKey THEN
- DrawKey(Rgn, EditKey)
- END;
-
- PROCEDURE ValidateEdit;
- { validate user editing of the selected key }
- VAR
- BlockNumber : Integer;
- MapAddress, NewAsciiCode : LongInt;
- BEGIN
- IF EditOn THEN
- BEGIN
- StringToNum(GetDItemText(DemoDialog, EditCodeItem), NewAsciiCode);
- MapAddress := Ord4(KChrHandle^);
- BlockNumber := Peek(MapAddress + BitShift(EditModifs, -8) + 2);
- Poke(MapAddress + 260 + BlockNumber * 128 + EditKey, NewAsciiCode);
- EditOn := False;
- SetDItemText(DemoDialog, EditCodeItem, '');
- SetDItemText(DemoDialog, KeyCodeItem, '');
- SetDItemText(DemoDialog, AsciiCharItem, '');
- HiliteKeys := HiliteKeys - [EditKey];
- MainCaps(DrawEditKRgn);
- END
- END;
-
- PROCEDURE CodeXORModifs (ModifCode : Integer;
- VAR Modifs : Integer);
- { XOR new modifier with the already selected ones }
- VAR
- TempModifs : Integer;
- BEGIN
- TempModifs := 0;
- BitSet(@TempModifs, $3E - ModifCode);
- Modifs := BitXor(Modifs, TempModifs)
- END;
-
- FUNCTION EditPerm (KeyCode, Modifs : Integer;
- VAR AsciiCode : Integer) : Boolean;
- { can that key be edited ? }
- BEGIN
- IF GetAscii(KeyCode, Modifs, AsciiCode) THEN
- EditPerm := true
- ELSE { check that it's not a double strike nor a modifier }
- EditPerm := (AsciiCode = 0) AND NOT (KeyCode IN [$3C..$3E])
- END;
-
- PROCEDURE ActiveClick (rgn : RgnHandle;
- Code : integer);
- VAR
- AsciiCode : Integer;
- BEGIN
- IF PtInRgn(MouseLocal, Rgn) THEN
- IF (Code <> EditKey) OR NOT EditOn THEN
- BEGIN
- ValidateEdit;
- IF Code IN [$37..$3B] THEN { modifier key was clicked }
- BEGIN
- CodeXORModifs(Code, EditModifs);
- IF Code IN HiliteKeys THEN
- HiliteKeys := HiliteKeys - [Code]
- ELSE
- HiliteKeys := HiliteKeys + [Code];
- IF EditPerm(EditKey, EditModifs, AsciiCode) THEN
- StartEdit(EditKey, AsciiCode);
- MainCaps(DrawKey) { redraw the keyboard to update hiliting }
- END
- ELSE IF EditPerm(Code, EditModifs, AsciiCode) THEN
- BEGIN
- InvertKey(Rgn); { hilite it , and let user edit it }
- StartEdit(Code, AsciiCode)
- END
- END
- END;
-
- FUNCTION CheckSysTrans (TransData : Ptr) : Boolean;
- { is TransData really a pointer to the system mapping table ?? }
- VAR
- KeyCode, AsciiCode : Integer;
- BEGIN
- CheckSysTrans := true;
- FOR KeyCode := 0 TO 16 DO
- BEGIN
- AsciiCode := Key12Trans(KeyCode, 0); { let system compute it }
- IF Peek(Ord4(TransData) + 260 + KeyCode) <> AsciiCode THEN
- CheckSysTrans := False; { compare with our table }
- IF AsciiCode = 0 THEN
- BEGIN
- AsciiCode := Key12Trans(KeyCode, 0);
- FlushEvents(EveryEvent, 0) { double strike may have posted an event , flush it }
- END
- END
- END;
-
- FUNCTION GetSysTrans (VAR TheTrans : Ptr) : boolean;
- VAR
- BGlob, Addr : PLong;
- BEGIN
- Bglob := PLong(BasicGlob);
- Addr := PLong(BGlob^ + 14);
- { not documented , so better check if we can rely on it ! }
- TheTrans := Ptr(Addr^);
- GetSysTrans := CheckSysTrans(TheTrans)
- END;
-
- PROCEDURE DoLoad;
- VAR
- TheSize : LongInt;
- RamTransPtr : Ptr;
- SysKchr : Handle;
- AppResFile : integer;
- BEGIN
- IF Alert(LoadAlrt, NIL) = Ok THEN
- BEGIN
- TheSize := GetHandleSize(KChrHandle);
- IF GetSysTrans(RamTransPtr) THEN { see above ... }
- BlockMove(KChrHandle^, RamTransPtr, TheSize);
- AppResFile := CurResFile;
- UseResFile(0);
- SysKchr := GetResource('KCHR', 0);
- BlockMove(KChrHandle^, SysKChr^, TheSize);
- ChangedResource(SysKChr);
- UpdateResFile(0);
- UseResFile(AppResFile)
- END
- END;
-
- PROCEDURE DoDialog (TheEvent : EventRecord);
- CONST
- Enter = $03;
- Return = $0D;
- VAR
- TheDialog : DialogPtr;
- ItemHit, CharCode : Integer;
- PassIt : Boolean;
- BEGIN
- WITH TheEvent DO
- IF What = KeyDown THEN
- BEGIN { filter key down events }
- CharCode := BitAnd(Message, CharCodeMask);
- PassIt := False;
- IF BitAnd(Modifiers, CmdKey) <> 0 THEN
- DoMenu(MenuKey(Chr(CharCode)))
- ELSE IF EditOn THEN
- IF CharCode IN [Return, Enter] THEN
- ValidateEdit
- ELSE
- PassIt := True
- END
- ELSE
- PassIt := True;
- IF PassIt THEN
- IF DialogSelect(TheEvent, TheDialog, ItemHit) THEN
- CASE ItemHit OF
- UserItem :
- MainCaps(ActiveClick);
- LoadBtn :
- DoLoad;
- OTHERWISE
- END
- END;
-
- PROCEDURE MainLoop;
- VAR
- GotEvent : Boolean;
- TheEvent : EventRecord;
- TheWindow : WindowPtr;
- BEGIN
- SystemTask;
- GotEvent := GetNextEvent(EveryEvent, TheEvent);
- IF IsDialogEvent(TheEvent) THEN
- DoDialog(TheEvent)
- ELSE IF GotEvent THEN
- WITH TheEvent DO
- CASE What OF
- MouseDown :
- CASE FindWindow(Where, TheWindow) OF
- inMenuBar :
- DoMenu(MenuSelect(Where));
- inSysWindow :
- SystemClick(TheEvent, TheWindow);
- inContent :
- IF TheWindow <> FrontWindow THEN
- SelectWindow(TheWindow);
- inDrag :
- DragWindow(TheWindow, Where, DragRect);
- inGoaway :
- IF TheWindow <> FrontWindow THEN
- SelectWindow(TheWindow)
- ELSE IF TrackGoAway(TheWindow, Where) THEN
- Finished := True;
- OTHERWISE
- END;
- KeyDown :
- IF BitAnd(Modifiers, CmdKey) <> 0 THEN
- DoMenu(MenuKey(Chr(BitAnd(Message, CharCodeMask))));
- UpdateEvt :
- BEGIN { just in case ... }
- TheWindow := WindowPtr(Message);
- BeginUpdate(TheWindow);
- EndUpdate(TheWindow)
- END;
- OTHERWISE
- END
- END;
-
- BEGIN
- InitThings;
- REPEAT
- MainLoop
- UNTIL Finished
- END.